home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / API / SAMPLES / FOXTLIB / FTLIBCTL.CPP < prev    next >
Encoding:
C/C++ Source or Header  |  1998-05-26  |  35.6 KB  |  1,431 lines
  1. // FoxtlibCtl.cpp : Implementation of the CFoxtlibCtrl OLE control class.
  2.  
  3. #include "stdafx.h"
  4. #include "foxtlib.h"
  5. #include "FoxtlibCtl.h"
  6. #include "FoxtlibPpg.h"
  7. #include "pro_ext.h"
  8. #include "malloc.h"
  9.  
  10. #ifdef _DEBUG
  11. #define new DEBUG_NEW
  12. #undef THIS_FILE
  13. static char THIS_FILE[] = __FILE__;
  14. #endif
  15.  
  16. #define MAXPARMS 20    //max # of names for SetFuncAndParamNames (1 + # of parms)
  17.  
  18. #define VALUE_N_I(val)  (val.ev_type =='I' ? val.ev_long : (long)val.ev_real)
  19.  
  20. IMPLEMENT_DYNCREATE(CFoxtlibCtrl, COleControl)
  21.  
  22.  
  23. /////////////////////////////////////////////////////////////////////////////
  24. // Message map
  25.  
  26. BEGIN_MESSAGE_MAP(CFoxtlibCtrl, COleControl)
  27.     //{{AFX_MSG_MAP(CFoxtlibCtrl)
  28.     // NOTE - ClassWizard will add and remove message map entries
  29.     //    DO NOT EDIT what you see in these blocks of generated code !
  30.     //}}AFX_MSG_MAP
  31.     ON_OLEVERB(AFX_IDS_VERB_EDIT, OnEdit)
  32.     ON_OLEVERB(AFX_IDS_VERB_PROPERTIES, OnProperties)
  33. END_MESSAGE_MAP()
  34.  
  35.  
  36. /////////////////////////////////////////////////////////////////////////////
  37. // Dispatch map
  38.  
  39. BEGIN_DISPATCH_MAP(CFoxtlibCtrl, COleControl)
  40.     //{{AFX_DISPATCH_MAP(CFoxtlibCtrl)
  41.     DISP_FUNCTION(CFoxtlibCtrl, "TLLoadTypeLib", TLLoadTypeLib, VT_I4, VTS_BSTR)
  42.     DISP_FUNCTION(CFoxtlibCtrl, "TLRelease", TLRelease, VT_I4, VTS_I4)
  43.     DISP_FUNCTION(CFoxtlibCtrl, "TLGetTypeInfoCount", TLGetTypeInfoCount, VT_I4, VTS_I4)
  44.     DISP_FUNCTION(CFoxtlibCtrl, "TLGetTypeAttr", TLGetTypeAttr, VT_I4, VTS_I4 VTS_BSTR)
  45.     DISP_FUNCTION(CFoxtlibCtrl, "TLGetTypeInfo", TLGetTypeInfo, VT_I4, VTS_I4 VTS_I4)
  46.     DISP_FUNCTION(CFoxtlibCtrl, "TLGetDocumentation", TLGetDocumentation, VT_I4, VTS_I4 VTS_BSTR VTS_I4 VTS_I4)
  47.     DISP_FUNCTION(CFoxtlibCtrl, "TIGetNames", TIGetNames, VT_I4, VTS_I4 VTS_BSTR VTS_I4)
  48.     DISP_FUNCTION(CFoxtlibCtrl, "TIGetFuncDesc", TIGetFuncDesc, VT_I4, VTS_I4 VTS_BSTR VTS_I4 VTS_BSTR)
  49.     DISP_FUNCTION(CFoxtlibCtrl, "TLWCreateTypeLib", TLWCreateTypeLib, VT_I4, VTS_BSTR VTS_PI4)
  50.     DISP_FUNCTION(CFoxtlibCtrl, "TIGetVarDesc", TIGetVarDesc, VT_I4, VTS_I4 VTS_BSTR VTS_I4)
  51.     DISP_FUNCTION(CFoxtlibCtrl, "TLWSaveAllChanges", TLWSaveAllChanges, VT_I4, VTS_I4)
  52.     DISP_FUNCTION(CFoxtlibCtrl, "TIWCreateTypeInfo", TIWCreateTypeInfo, VT_I4, VTS_I4 VTS_I4 VTS_PI4 VTS_BSTR VTS_BSTR VTS_PI4)
  53.     DISP_FUNCTION(CFoxtlibCtrl, "TLIWWriteDocumentation", TLIWWriteDocumentation, VT_I4, VTS_I4 VTS_BSTR VTS_BSTR VTS_I4 VTS_BSTR VTS_I4)
  54.     DISP_FUNCTION(CFoxtlibCtrl, "TILayout", TILayout, VT_I4, VTS_I4)
  55.     DISP_FUNCTION(CFoxtlibCtrl, "TIRelease", TIRelease, VT_I4, VTS_I4)
  56.     DISP_FUNCTION(CFoxtlibCtrl, "TIAddFuncDesc", TIAddFuncDesc, VT_I4, VTS_I4 VTS_I4 VTS_BSTR VTS_BSTR VTS_BSTR VTS_I4)
  57.     //}}AFX_DISPATCH_MAP
  58. END_DISPATCH_MAP()
  59.  
  60.  
  61. /////////////////////////////////////////////////////////////////////////////
  62. // Event map
  63.  
  64. BEGIN_EVENT_MAP(CFoxtlibCtrl, COleControl)
  65.     //{{AFX_EVENT_MAP(CFoxtlibCtrl)
  66.     // NOTE - ClassWizard will add and remove event map entries
  67.     //    DO NOT EDIT what you see in these blocks of generated code !
  68.     //}}AFX_EVENT_MAP
  69. END_EVENT_MAP()
  70.  
  71.  
  72. /////////////////////////////////////////////////////////////////////////////
  73. // Property pages
  74.  
  75. // TODO: Add more property pages as needed.  Remember to increase the count!
  76. BEGIN_PROPPAGEIDS(CFoxtlibCtrl, 1)
  77.     PROPPAGEID(CFoxtlibPropPage::guid)
  78. END_PROPPAGEIDS(CFoxtlibCtrl)
  79.  
  80.  
  81. /////////////////////////////////////////////////////////////////////////////
  82. // Initialize class factory and guid
  83.  
  84. IMPLEMENT_OLECREATE_EX(CFoxtlibCtrl, "FOXTLIB.FoxtlibCtrl.1",
  85.     0x22852ee3, 0xb01b, 0x11cf, 0xb8, 0x26, 0, 0xa0, 0xc9, 0x5, 0x5d, 0x9e)
  86.  
  87.  
  88. /////////////////////////////////////////////////////////////////////////////
  89. // Type library ID and version
  90.  
  91. IMPLEMENT_OLETYPELIB(CFoxtlibCtrl, _tlid, _wVerMajor, _wVerMinor)
  92.  
  93.  
  94. /////////////////////////////////////////////////////////////////////////////
  95. // Interface IDs
  96.  
  97. const IID BASED_CODE IID_DFoxtlib =
  98.         { 0x22852ee9, 0xb01b, 0x11cf, { 0xb8, 0x26, 0, 0xa0, 0xc9, 0x5, 0x5d, 0x9e } };
  99. const IID BASED_CODE IID_DFoxtlibEvents =
  100.         { 0x22852eea, 0xb01b, 0x11cf, { 0xb8, 0x26, 0, 0xa0, 0xc9, 0x5, 0x5d, 0x9e } };
  101.  
  102.  
  103. /////////////////////////////////////////////////////////////////////////////
  104. // Control type information
  105.  
  106. static const DWORD BASED_CODE _dwFoxtlibOleMisc =
  107.     OLEMISC_INVISIBLEATRUNTIME |
  108.     OLEMISC_SETCLIENTSITEFIRST |
  109.     OLEMISC_INSIDEOUT |
  110.     OLEMISC_CANTLINKINSIDE |
  111.     OLEMISC_RECOMPOSEONRESIZE;
  112.  
  113. IMPLEMENT_OLECTLTYPE(CFoxtlibCtrl, IDS_FOXTLIB, _dwFoxtlibOleMisc)
  114.  
  115.  
  116. /////////////////////////////////////////////////////////////////////////////
  117. // CFoxtlibCtrl::CFoxtlibCtrlFactory::UpdateRegistry -
  118. // Adds or removes system registry entries for CFoxtlibCtrl
  119.  
  120. BOOL CFoxtlibCtrl::CFoxtlibCtrlFactory::UpdateRegistry(BOOL bRegister)
  121. {
  122.     // TODO: Verify that your control follows apartment-model threading rules.
  123.     // Refer to MFC TechNote 64 for more information.
  124.     // If your control does not conform to the apartment-model rules, then
  125.     // you must modify the code below, changing the 6th parameter from
  126.     // afxRegInsertable | afxRegApartmentThreading to afxRegInsertable.
  127.  
  128.     if (bRegister)
  129.         return AfxOleRegisterControlClass(
  130.             AfxGetInstanceHandle(),
  131.             m_clsid,
  132.             m_lpszProgID,
  133.             IDS_FOXTLIB,
  134.             IDB_FOXTLIB,
  135.             afxRegInsertable | afxRegApartmentThreading,
  136.             _dwFoxtlibOleMisc,
  137.             _tlid,
  138.             _wVerMajor,
  139.             _wVerMinor);
  140.     else
  141.         return AfxOleUnregisterClass(m_clsid, m_lpszProgID);
  142. }
  143.  
  144.  
  145. /////////////////////////////////////////////////////////////////////////////
  146. // CFoxtlibCtrl::CFoxtlibCtrl - Constructor
  147.  
  148. CFoxtlibCtrl::CFoxtlibCtrl()
  149. {
  150.     InitializeIIDs(&IID_DFoxtlib, &IID_DFoxtlibEvents);
  151.     if (!_OCXAPI(AfxGetInstanceHandle(),DLL_PROCESS_ATTACH))
  152.     {
  153.         ::MessageBox(0,"This OCX can only be hosted by Visual Foxpro","",0);
  154.         //Here you can do whatever you want when the host isn't VFP:
  155.         // you might want to reject loading or you might want to set a property
  156.         //saying that the host isn't VFP and the control will use other means
  157.         // to achieve it's purpose.
  158.     }
  159. }
  160.  
  161.  
  162. /////////////////////////////////////////////////////////////////////////////
  163. // CFoxtlibCtrl::~CFoxtlibCtrl - Destructor
  164.  
  165. CFoxtlibCtrl::~CFoxtlibCtrl()
  166. {
  167.     _OCXAPI(AfxGetInstanceHandle(),DLL_PROCESS_DETACH);
  168. }
  169.  
  170.  
  171. /////////////////////////////////////////////////////////////////////////////
  172. // CFoxtlibCtrl::OnDraw - Drawing function
  173.  
  174. void CFoxtlibCtrl::OnDraw(
  175.             CDC* pdc, const CRect& rcBounds, const CRect& rcInvalid)
  176. {
  177.     // TODO: Replace the following code with your own drawing code.
  178.     pdc->FillRect(rcBounds, CBrush::FromHandle((HBRUSH)GetStockObject(WHITE_BRUSH)));
  179.     pdc->Ellipse(rcBounds);
  180. }
  181.  
  182.  
  183. /////////////////////////////////////////////////////////////////////////////
  184. // CFoxtlibCtrl::DoPropExchange - Persistence support
  185.  
  186. void CFoxtlibCtrl::DoPropExchange(CPropExchange* pPX)
  187. {
  188.     ExchangeVersion(pPX, MAKELONG(_wVerMinor, _wVerMajor));
  189.     COleControl::DoPropExchange(pPX);
  190.  
  191.     // TODO: Call PX_ functions for each persistent custom property.
  192.  
  193. }
  194.  
  195.  
  196. /////////////////////////////////////////////////////////////////////////////
  197. // CFoxtlibCtrl::OnResetState - Reset control to default state
  198.  
  199. void CFoxtlibCtrl::OnResetState()
  200. {
  201.     COleControl::OnResetState();  // Resets defaults found in DoPropExchange
  202.  
  203.     // TODO: Reset any other control state here.
  204. }
  205.  
  206.  
  207. /////
  208.  
  209.  
  210.  
  211. #include "winnls.h"
  212.  
  213. void OLEFreeString(void **ppsz)
  214. {
  215.     HRESULT     hr;
  216.     IMalloc        *pIMalloc;
  217.  
  218.     if (NULL != ppsz && NULL != *ppsz)
  219.     {
  220.         hr = CoGetMalloc(MEMCTX_TASK, &pIMalloc);
  221.  
  222.         if (FAILED(hr))
  223.             return;
  224.         
  225.         pIMalloc->Free(*ppsz);
  226.  
  227.         pIMalloc->Release();
  228.         
  229.         *ppsz = NULL;
  230.     }
  231.     
  232.     return;
  233. }
  234.  
  235. HRESULT OLECopyAnsiToOle(const TEXT *pszA, OLECHAR *pszW, int cbW)
  236. {
  237.     ULONG    cchW;
  238.     HRESULT    hr;
  239.  
  240.  
  241.     hr = NOERROR;
  242.     
  243.     cchW = cbW / sizeof(OLECHAR);    // do this here in case cbW == 1 which is invalid
  244.     
  245.     if (!pszW || !cchW)
  246.     {
  247.         hr = ResultFromScode(E_INVALIDARG);
  248.     }
  249.     else
  250.     {
  251.         *pszW = '\0';
  252.         
  253.         if (pszA && *pszA)
  254.         {
  255. #if WIN32
  256.             if (MultiByteToWideChar(CP_ACP, 0, (LPSTR)pszA, -1, pszW, cchW) == 0)
  257.             {
  258.                 *pszW = '\0';
  259.                 hr = ResultFromScode(E_FAIL);
  260.             }
  261. #elif MAC_OS
  262.             // NO MAC UNICODE YET
  263.             strncpy(pszW, (char *) pszA, cchW);
  264. #endif
  265.         }
  266.     }
  267.  
  268.     return (hr);
  269. }
  270.  
  271.  
  272. HRESULT OLEConvertStringAlloc(ULONG ulSize, void **ppv)
  273. {
  274.     HRESULT     hr;
  275.     IMalloc    *pIMalloc;
  276.  
  277.     // Reject zero-length strings, because a valid, but empty, ptr. would get
  278.     // allocated, which might confuse the caller.
  279.     if ((ulSize == 0) || (ppv == NULL))
  280.     {
  281.         return (ResultFromScode(E_INVALIDARG));
  282.     }
  283.  
  284.     *ppv = NULL;
  285.     
  286.     hr = CoGetMalloc(MEMCTX_TASK, &pIMalloc);
  287.  
  288.     if (!SUCCEEDED(hr))
  289.         return (hr);
  290.  
  291.     *ppv = pIMalloc->Alloc(ulSize);
  292.     pIMalloc->Release();
  293.  
  294.     if (*ppv != NULL)
  295.         memset(*ppv, 0, ulSize);
  296.  
  297.     return ((*ppv == NULL) ? ResultFromScode(E_OUTOFMEMORY) : ResultFromScode(NOERROR));
  298. }
  299.  
  300.  
  301.  
  302. HRESULT OLEAnsiToOleString(const TEXT *pszA, OLECHAR **ppszW)
  303. {
  304.     ULONG   cch,     // character count
  305.             cb;        // byte count
  306.     HRESULT hr;
  307.  
  308.  
  309.     if (!ppszW)
  310.         return (ResultFromScode(E_INVALIDARG));
  311.  
  312.     *ppszW = NULL;
  313.     hr = NOERROR;
  314.  
  315.     if (pszA)
  316.     {
  317. #if WIN32
  318.         cch = MultiByteToWideChar(CP_ACP, 0, (LPSTR)pszA, -1, NULL, 0);
  319. #elif MAC_OS
  320.         // NO MAC UNICODE YET
  321.         cch = strlen((char *) pszA) + 1;
  322. #endif
  323.  
  324.         cb = cch * sizeof(OLECHAR);
  325.     }
  326.         
  327.     if (SUCCEEDED(hr = OLEConvertStringAlloc(cb, (void **)ppszW)))
  328.     {
  329.         hr = OLECopyAnsiToOle(pszA, *ppszW, cb);
  330.         if (FAILED(hr))
  331.             OLEFreeString((void **)ppszW);    // This will set *ppszW = NULL.
  332.     }
  333.     return (hr);
  334. }
  335.  
  336.  
  337. HRESULT OLECopyOleToAnsi(OLECHAR *pszW, TEXT *pszA, int cbA)
  338. {
  339.     HRESULT    hr = NOERROR;
  340.     
  341.     if (!pszA || !cbA)
  342.     {
  343.         hr = ResultFromScode(E_INVALIDARG);
  344.     }
  345.     else
  346.     {
  347.         *pszA = '\0';
  348.         
  349.         if (pszW && *pszW)
  350.         {
  351. #if WIN32
  352.             if (WideCharToMultiByte(CP_ACP, 0, pszW, -1, (LPSTR)pszA, cbA, NULL, NULL) == 0)
  353.             {
  354.                 *pszA = '\0';
  355.                 hr = ResultFromScode(E_FAIL);
  356.             }
  357. #elif MAC_OS
  358.             // NO MAC UNICODE YET
  359.             strncpy((char *) pszA, pszW, cbA);
  360. #endif
  361.         }
  362.     }
  363.  
  364.     return (hr);
  365. }
  366.  
  367. HRESULT OLEOleToAnsiString(OLECHAR *pszW, TEXT **ppszA)
  368. {
  369.     ULONG   cch,     // character count
  370.             cb;        // byte count
  371.     HRESULT hr;
  372.  
  373.  
  374.     if (!ppszA)
  375.         return (ResultFromScode(E_INVALIDARG));
  376.  
  377.     *ppszA = NULL;
  378.     hr = NOERROR;
  379.  
  380.     if (pszW)
  381.     {
  382. #if WIN32
  383.         cch = WideCharToMultiByte(CP_ACP, 0, pszW, -1, NULL, 0, NULL, NULL);
  384. #elif MAC_OS
  385.         // NO MAC UNICODE YET
  386.         cch = strlen(pszW) + 1;
  387. #endif
  388.  
  389.         cb = cch;
  390.         
  391.         if (SUCCEEDED(hr = OLEConvertStringAlloc(cb, (void **)ppszA)))
  392.         {
  393.             hr = OLECopyOleToAnsi(pszW, *ppszA, cb);
  394.             if (FAILED(hr))
  395.                 OLEFreeString((void **)ppszA);    // This will set *ppszA = NULL.
  396.         }
  397.     }
  398.     
  399.     return (hr);
  400. }
  401.  
  402.  
  403.  
  404. void StoreBstr(Locator *ploc,int index, BSTR *lpBstr) {
  405.     char *szBuff;
  406.     Value val;
  407.     OLEOleToAnsiString(*lpBstr,&szBuff);
  408.     SysFreeString(*lpBstr);
  409.     val.ev_type = 'C';
  410.     ploc->l_sub1 = index;
  411.     if (szBuff) {
  412.         val.ev_length = strlen(szBuff);
  413.         val.ev_handle = _AllocHand(val.ev_length);
  414.         _HLock(val.ev_handle);
  415.         _MemMove(_HandToPtr(val.ev_handle),szBuff,val.ev_length);
  416.         _Store(ploc,&val);
  417.         _HUnLock(val.ev_handle);
  418.         _FreeHand(val.ev_handle);
  419.     } else {
  420.         val.ev_length = val.ev_handle = 0;
  421.         _Store(ploc,&val);
  422.     }
  423. }
  424.  
  425.  
  426.  
  427. //Wrapper to work around a buffer allocation problem
  428. NTI MyNameTableIndex(char *name) {
  429.     char szBuff[256];
  430.     strcpy(szBuff,name);
  431.     return _NameTableIndex(szBuff);
  432. }
  433.  
  434.  
  435. /////////////////////////////////////////////////////////////////////////////
  436. // CFoxtlibCtrl message handlers
  437.  
  438.  
  439.  
  440. long CFoxtlibCtrl::TLLoadTypeLib(LPCTSTR szFileName) 
  441. {
  442.     Value val;
  443.     _Evaluate(&val,"recno()+5");
  444.     _Execute("jj=eval('recno()')");
  445.     OLECHAR *OFileName;
  446.     HRESULT hr;
  447.     ITypeLib * lptlib;
  448.     OLEAnsiToOleString((TEXT *)szFileName,&OFileName);
  449.     hr =  ::LoadTypeLib(OFileName, &lptlib);
  450.     OLEFreeString((void **)&OFileName);
  451.     if (SUCCEEDED(hr))
  452.         return (long)lptlib;
  453.  
  454.     return 0;
  455. }
  456.  
  457. long CFoxtlibCtrl::TLRelease(long pTypeInfo) 
  458. {
  459.     int nResult;
  460.     __try {
  461.         nResult = ((ITypeLib *)pTypeInfo)->Release();
  462.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  463.  
  464.         nResult = 0;
  465.     }
  466.     return nResult;
  467. }
  468.  
  469. long CFoxtlibCtrl::TLGetTypeInfoCount(long pTypeInfo) 
  470. {
  471.     int nResult;
  472.     __try {
  473.         nResult = ((ITypeLib *)pTypeInfo)->GetTypeInfoCount();
  474.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  475.  
  476.         nResult = 0;
  477.     }
  478.     return nResult;
  479. }
  480.  
  481. long CFoxtlibCtrl::TLGetTypeAttr(long pTypeInfo, LPCTSTR szArrName) 
  482. {
  483.     int nResult = 1;
  484.     TYPEATTR *lpTypeAttr;
  485.     Locator loc;
  486.     Value val;
  487.     OLECHAR szGuid[128];
  488.     char *szBuff;
  489.     __try {
  490.         if (_FindVar(MyNameTableIndex((char *)szArrName),-1,&loc)) {
  491.             ((ITypeInfo *)pTypeInfo)->GetTypeAttr(&lpTypeAttr);
  492.             if (_ALen(loc.l_NTI, AL_ELEMENTS) < 16)
  493.             {
  494.                 throw(631); //"Array argument not of proper size.");
  495.             }
  496.  
  497.             //1 = Guid
  498.             StringFromGUID2(lpTypeAttr->guid,(LPOLESTR )&szGuid,sizeof(szGuid));
  499.             OLEOleToAnsiString(szGuid,&szBuff);
  500.             val.ev_type = 'C';
  501.             val.ev_length = strlen(szBuff);
  502.             val.ev_handle = _AllocHand(val.ev_length);
  503.             _HLock(val.ev_handle);
  504.             _MemMove((char *)_HandToPtr(val.ev_handle),szBuff,val.ev_length);
  505.             OLEFreeString((void **)&szBuff);
  506.             _HUnLock(val.ev_handle);
  507.  
  508.             loc.l_sub1 = 1;
  509.             _Store(&loc,&val);
  510.             _FreeHand(val.ev_handle);
  511.  
  512.             //2 = LCID
  513.             loc.l_sub1 = 2;
  514.             val.ev_type = 'I';
  515.             val.ev_long = lpTypeAttr->lcid;
  516.             _Store(&loc,&val);
  517.  
  518.             //3 dwReserved
  519.             loc.l_sub1 = 3;
  520.             val.ev_type = 'I';
  521.             val.ev_long = lpTypeAttr->dwReserved;
  522.             _Store(&loc,&val);
  523.  
  524.             //4 Constructor
  525.             loc.l_sub1 = 4;
  526.             val.ev_type = 'I';
  527.             val.ev_long = lpTypeAttr->memidConstructor;
  528.             _Store(&loc,&val);
  529.  
  530.             //5 Destructor
  531.             loc.l_sub1 = 5;
  532.             val.ev_type = 'I';
  533.             val.ev_long = lpTypeAttr->memidDestructor;
  534.             _Store(&loc,&val);
  535.  
  536.             //6 lpstrSchema reserved
  537.             loc.l_sub1 = 6;
  538.             val.ev_type = 'I';
  539.             val.ev_long = (int)lpTypeAttr->lpstrSchema;
  540.             _Store(&loc,&val);
  541.  
  542.             //7 size Instance
  543.             loc.l_sub1 = 7;
  544.             val.ev_type = 'I';
  545.             val.ev_long = lpTypeAttr->cbSizeInstance;
  546.             _Store(&loc,&val);
  547.  
  548.             //8 TypeKind
  549.             loc.l_sub1 = 8;
  550.             val.ev_type = 'I';
  551.             val.ev_long = lpTypeAttr->typekind;
  552.             _Store(&loc,&val);
  553.  
  554.             //9 cFuncs
  555.             loc.l_sub1 = 9;
  556.             val.ev_type = 'I';
  557.             val.ev_long = lpTypeAttr->cFuncs;
  558.             _Store(&loc,&val);
  559.  
  560.             //10 cVars
  561.             loc.l_sub1 = 10;
  562.             val.ev_type = 'I';
  563.             val.ev_long = lpTypeAttr->cVars;
  564.             _Store(&loc,&val);
  565.  
  566.             //11 cImplTypes
  567.             loc.l_sub1 = 11;
  568.             val.ev_type = 'I';
  569.             val.ev_long = lpTypeAttr->cImplTypes;
  570.             _Store(&loc,&val);
  571.  
  572.             //12 cbSizeVft
  573.             loc.l_sub1 = 12;
  574.             val.ev_type = 'I';
  575.             val.ev_long = lpTypeAttr->cbSizeVft;
  576.             _Store(&loc,&val);
  577.  
  578.             //13 cbAlignment
  579.             loc.l_sub1 = 13;
  580.             val.ev_type = 'I';
  581.             val.ev_long = lpTypeAttr->cbAlignment;
  582.             _Store(&loc,&val);
  583.  
  584.             //14 wTypeFlags
  585.             loc.l_sub1 = 14;
  586.             val.ev_type = 'I';
  587.             val.ev_long = lpTypeAttr->wTypeFlags;
  588.             _Store(&loc,&val);
  589.  
  590.             //15 wMajorVerNum
  591.             loc.l_sub1 = 15;
  592.             val.ev_type = 'I';
  593.             val.ev_long = lpTypeAttr->wMajorVerNum;
  594.             _Store(&loc,&val);
  595.  
  596.             //16 wMinorVerNum
  597.             loc.l_sub1 = 16;
  598.             val.ev_type = 'I';
  599.             val.ev_long = lpTypeAttr->wMinorVerNum;
  600.             _Store(&loc,&val);
  601.  
  602.             ((ITypeInfo *)pTypeInfo)->ReleaseTypeAttr(lpTypeAttr);
  603.  
  604.         }
  605.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  606.         nResult = 0;
  607.     }
  608.     return nResult;
  609. }
  610.  
  611. long CFoxtlibCtrl::TLGetTypeInfo(long pTypeInfo,long nIndex) 
  612. {
  613.     ITypeInfo * lpTypeInfo;
  614.     int nResult;
  615.     __try {
  616.         nResult = ((ITypeLib *)pTypeInfo)->GetTypeInfo(nIndex,&lpTypeInfo);
  617.         if (SUCCEEDED(nResult))
  618.             nResult = (int) lpTypeInfo;
  619.  
  620.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  621.         nResult = 0;
  622.     }
  623.     return nResult;
  624. }
  625. //                =GetDocumentation(m.ITypeInfo,@ta,m.j)
  626.  
  627. long CFoxtlibCtrl::TLGetDocumentation(long pTypeInfo, LPCTSTR szArrName, long nIndex,long nKind) 
  628. {
  629.     //Kind = 0 for TypeLib, 1 for TypeInfo
  630.     int nResult = 1;
  631.     BSTR bstrName;
  632.     BSTR bstrDocString;
  633.     unsigned long dwHelpContext;
  634.     BSTR bstrHelpFile;
  635.     Locator loc;
  636.     Value val;
  637.     __try {
  638.         if (_FindVar(MyNameTableIndex((char *)szArrName),-1,&loc)) {
  639.             if (nKind)
  640.             {
  641.                 ((ITypeInfo *)pTypeInfo)->GetDocumentation(nIndex ,&bstrName,&bstrDocString,
  642.                     &dwHelpContext,&bstrHelpFile);
  643.             } else {
  644.                 ((ITypeLib *)pTypeInfo)->GetDocumentation(nIndex ,&bstrName,&bstrDocString,
  645.                     &dwHelpContext,&bstrHelpFile);
  646.             }
  647.             if (_ALen(loc.l_NTI, AL_ELEMENTS) < 4)
  648.             {
  649.                 throw(631); //"Array argument not of proper size.");
  650.             }
  651.  
  652.             StoreBstr(&loc,1,&bstrName);
  653.             StoreBstr(&loc,2,&bstrDocString);
  654.             StoreBstr(&loc,3,&bstrHelpFile);
  655.  
  656.             loc.l_sub1 = 4;
  657.             val.ev_type = 'I';
  658.             val.ev_long = dwHelpContext;
  659.             _Store(&loc,&val);
  660.         }
  661.  
  662.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  663.         nResult = 0;
  664.     }
  665.     return nResult;
  666. }
  667.  
  668. long CFoxtlibCtrl::TIGetNames(long pTypeInfo, LPCTSTR szArrName, long nMemId) 
  669. {
  670.     int nResult = 1;
  671.     Locator loc;
  672.     __try {
  673.         if (_FindVar(MyNameTableIndex((char *)szArrName),-1,&loc)) {
  674.             BSTR rgbstrNames[MAXPARMS];
  675.             int cNames = 0;
  676.  
  677.             ((ITypeInfo *)pTypeInfo)->GetNames(nMemId,rgbstrNames,MAXPARMS,(UINT *)&cNames);
  678.             if (cNames)
  679.             {
  680.  
  681.                 if (_ALen(loc.l_NTI, AL_ELEMENTS) < cNames)
  682.                 {
  683.                     throw(631); //"Array argument not of proper size.");
  684.                 }
  685.                 for (int i=1 ; i <= cNames ; i++)    {    //index through Fox array
  686.                     StoreBstr(&loc, i, &rgbstrNames[i-1]);
  687.                 }
  688.             }
  689.             nResult = cNames;
  690.         }
  691.  
  692.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  693.         nResult = 0;
  694.     }
  695.     return nResult;
  696. }
  697.  
  698. long CFoxtlibCtrl::TIGetFuncDesc(long pTypeInfo, LPCTSTR szArrName, long nIndex, LPCTSTR szParmsArr) 
  699. {
  700.     int nResult = 1;
  701.     Locator loc,ploc;
  702.     Value val;
  703.     __try {
  704.         if (_FindVar(MyNameTableIndex((char *)szArrName),-1,&loc)) {
  705.             FUNCDESC * lpFuncDesc;
  706.  
  707.             if (_ALen(loc.l_NTI, AL_ELEMENTS) < 5)
  708.             {
  709.                 throw(631); //"Array argument not of proper size.");
  710.             }
  711.             ((ITypeInfo *)pTypeInfo)->GetFuncDesc(nIndex,&lpFuncDesc);
  712.  
  713.             //1 = memid
  714.             loc.l_sub1 = 1;
  715.             val.ev_type = 'I';
  716.             val.ev_long = lpFuncDesc->memid;
  717.             _Store(&loc,&val);
  718.  
  719.             if (_FindVar(MyNameTableIndex((char *)szParmsArr),-1,&ploc)) {
  720.                 int nelem = lpFuncDesc->cParams + lpFuncDesc->cParamsOpt;
  721.                 if (_ALen(loc.l_NTI, AL_ELEMENTS) < nelem)
  722.                 {
  723.                     throw(631); //"Array argument not of proper size.");
  724.                 }
  725.                 ploc.l_sub1 = 1;
  726.                 val.ev_type = 'I';
  727.                 val.ev_long = (long) lpFuncDesc->elemdescFunc.tdesc.vt;
  728.                 _Store(&ploc,&val);
  729.                 for (int i = 0 ; i < nelem ; i++) {
  730.                     ploc.l_sub1 = 2 + i;        //start parms at xbase array element #2
  731.                     val.ev_type = 'I';
  732.                     val.ev_long = (long)lpFuncDesc->lprgelemdescParam[i].tdesc.vt;
  733.                     _Store(&ploc,&val);
  734.  
  735.                 }
  736.  
  737.  
  738.             }
  739.  
  740.             //2 = FUNCKIND
  741.             loc.l_sub1 = 2;
  742.             val.ev_type = 'I';
  743.             val.ev_long = lpFuncDesc->funckind;
  744.             _Store(&loc,&val);
  745.  
  746.             //3 = INVOKEKIND
  747.             loc.l_sub1 = 3;
  748.             val.ev_type = 'I';
  749.             val.ev_long = lpFuncDesc->invkind;
  750.             _Store(&loc,&val);
  751.  
  752.  
  753.             //4 = CALLCONV
  754.             loc.l_sub1 = 4;
  755.             val.ev_type = 'I';
  756.             val.ev_long = lpFuncDesc->callconv;
  757.             _Store(&loc,&val);
  758.  
  759.             //5 = cParams
  760.             loc.l_sub1 = 5;
  761.             val.ev_type = 'I';
  762.             val.ev_long = lpFuncDesc->cParams;
  763.             _Store(&loc,&val);
  764.  
  765.             //6 = cParamsOpt
  766.             loc.l_sub1 = 6;
  767.             val.ev_type = 'I';
  768.             val.ev_long = lpFuncDesc->cParamsOpt;
  769.             _Store(&loc,&val);
  770.  
  771.             //7 = oVft;
  772.             loc.l_sub1 = 7;
  773.             val.ev_type = 'I';
  774.             val.ev_long = lpFuncDesc->oVft;
  775.             _Store(&loc,&val);
  776.  
  777.             //8 = cScodes
  778.             loc.l_sub1 = 8;
  779.             val.ev_type = 'I';
  780.             val.ev_long = lpFuncDesc->cScodes;
  781.             _Store(&loc,&val);
  782.  
  783.  
  784.             //9 = wFuncFlags
  785.             loc.l_sub1 = 9;
  786.             val.ev_type = 'I';
  787.             val.ev_long = lpFuncDesc->wFuncFlags;
  788.             _Store(&loc,&val);
  789.  
  790.  
  791.             ((ITypeInfo *)pTypeInfo)->ReleaseFuncDesc(lpFuncDesc);
  792.         }
  793.  
  794.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  795.         nResult = 0;
  796.     }
  797.     return nResult;
  798. }
  799.  
  800. long ProcDesc(TYPEDESC *td) {
  801.     long lVal = 0;
  802.     switch(td->vt) {
  803.     case VT_PTR:
  804.     case VT_SAFEARRAY:
  805.         lVal = ProcDesc(td->lptdesc);
  806.         break;
  807.     case VT_CARRAY:
  808.         break;
  809.     case VT_USERDEFINED:
  810.         lVal= td->hreftype;
  811.         break;
  812.     default:
  813.         break;
  814.     }
  815.     return lVal;
  816. }
  817.  
  818. long CFoxtlibCtrl::TIGetVarDesc(long pTypeInfo, LPCTSTR szArrName, long nIndex) 
  819. {
  820.     int nResult = 1;
  821.     Locator loc;
  822.     Value val;
  823.     __try {
  824.         if (_FindVar(MyNameTableIndex((char *)szArrName),-1,&loc)) {
  825.             VARDESC * lpVarDesc;
  826.  
  827.             if (_ALen(loc.l_NTI, AL_ELEMENTS) < 5)
  828.             {
  829.                 throw(631); //"Array argument not of proper size.");
  830.             }
  831.             ((ITypeInfo *)pTypeInfo)->GetVarDesc(nIndex,&lpVarDesc);
  832.  
  833.             //1 = memid
  834.             loc.l_sub1 = 1;
  835.             val.ev_type = 'I';
  836.             val.ev_long = lpVarDesc->memid;
  837.             _Store(&loc,&val);
  838.  
  839.             //2 = wVarFlags
  840.             loc.l_sub1 = 2;
  841.             val.ev_type = 'I';
  842.             val.ev_long = (long) lpVarDesc->wVarFlags;
  843.             _Store(&loc,&val);
  844.  
  845.             //3 = Var kind
  846.             loc.l_sub1 = 3;
  847.             val.ev_type = 'I';
  848.             val.ev_long = (long) lpVarDesc->varkind;
  849.             _Store(&loc,&val);
  850.  
  851.             //4 = Var type
  852.             loc.l_sub1 = 4;
  853.             val.ev_type = 'I';
  854.             val.ev_long = (long) lpVarDesc->elemdescVar.tdesc.vt;
  855.             _Store(&loc,&val);
  856.  
  857.             //5 = wIDLFlags
  858.             loc.l_sub1 = 5;
  859.             val.ev_type = 'I';
  860.             val.ev_long = (long) lpVarDesc->elemdescVar.idldesc.wIDLFlags;
  861.             _Store(&loc,&val);
  862.  
  863.             //6 = dwReserved
  864.             loc.l_sub1 = 6;
  865.             val.ev_type = 'I';
  866.             val.ev_long = (long) lpVarDesc->elemdescVar.idldesc.dwReserved;
  867.             _Store(&loc,&val);
  868.  
  869.             //7,8 = mixture
  870.             loc.l_sub1 = 7;
  871.             val.ev_type = 'I';
  872.  
  873.             switch(lpVarDesc->varkind) {
  874.             case VAR_CONST:
  875.                 switch(lpVarDesc->lpvarValue->vt) {
  876.                 case VT_I4:
  877.                     val.ev_long = (long) lpVarDesc->lpvarValue->lVal;
  878.                     break;
  879.                 case VT_BOOL:
  880.                     val.ev_long = (long) lpVarDesc->lpvarValue->boolVal;
  881.                     break;
  882. //                case VT_BSTR:
  883. //bugbug                    StoreBstr(&loc,7,&lpVarDesc->lpvarValue->bstrVal);
  884. //                    break;
  885.                 }
  886.                 break;
  887.             case VAR_PERINSTANCE:
  888.                 val.ev_long = (long) lpVarDesc->oInst;
  889.                 break;
  890.             default:
  891.                 val.ev_long = lpVarDesc->elemdescVar.tdesc.lptdesc->vt;
  892.                 _Store(&loc,&val);
  893.  
  894.                 loc.l_sub1 = 8;
  895.                 val.ev_type = 'I';
  896.                 val.ev_long = ProcDesc(&lpVarDesc->elemdescVar.tdesc);
  897.                 break;
  898.             }
  899.             _Store(&loc,&val);
  900.  
  901.             ((ITypeInfo *)pTypeInfo)->ReleaseVarDesc(lpVarDesc);
  902.         }
  903.  
  904.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  905.         nResult = 0;
  906.     }
  907.     return nResult;
  908. }
  909.  
  910. //*********************************************
  911. //*********************************************
  912. //*********************************************
  913. //Create Typelib stuff
  914. //*********************************************
  915. //*********************************************
  916. //*********************************************
  917. long CFoxtlibCtrl::TLWCreateTypeLib(LPCTSTR szTLBName,long *res)
  918. {
  919.     HRESULT hr;
  920.     LPCREATETYPELIB lpCreateTypeLib;
  921.     OLECHAR *wTLBName;
  922.     __try {
  923.         *res = 0;
  924.         OLEAnsiToOleString(szTLBName,&wTLBName);
  925.         if ((hr = CreateTypeLib(SYS_WIN32,wTLBName,&lpCreateTypeLib)) == S_OK) {
  926.             *res = (long)lpCreateTypeLib;
  927.         }
  928.         OLEFreeString((void **)&wTLBName);
  929.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  930.         hr = E_FAIL;
  931.     }
  932.     return hr;
  933. }
  934.  
  935.  
  936. long CFoxtlibCtrl::TLWSaveAllChanges(long lpCreateTypeLib) //returns 0 on success
  937. {
  938.     HRESULT hr = E_FAIL;
  939.     __try {
  940.         hr = ((ICreateTypeLib *)lpCreateTypeLib)->SaveAllChanges();
  941.         ((ICreateTypeLib *)lpCreateTypeLib)->Release();
  942.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  943.         hr = E_FAIL;
  944.     }
  945.     return hr;
  946. }
  947.  
  948. /*HRESULT ICreateTypeInfo::AddRefTypeInfo(lptinfo, lphreftype)
  949. ITypeInfo FAR*  lptinfo
  950. HREFTYPE FAR*  lphreftype
  951.  
  952. The second parameter returns a pointer to the handle of the added type information. 
  953. If AddRefTypeInfo has been called previously for the same type information, the index 
  954. that was returned by the previous call is returned in lphreftype. If the referenced type 
  955. description is in the type library being created, its type information can be obtained by
  956.  calling IUnknown::QueryInterface(IID_ITypeInfo, ...) on the ICreateTypeInfo interface of that type description.
  957.   
  958. */
  959. HRESULT AddImplType(LPCREATETYPEINFO lpCreateTypeInfo, REFIID riid,LPTYPEINFO lpTypeInfo)
  960. {
  961.     HRESULT        hresult = E_FAIL;
  962.     char        szFile[MAX_PATH];
  963.     OLECHAR        *pOle;
  964.     LPTYPELIB    pITypeLib;
  965.     LPTYPEINFO    lpIDispatchTypeInfo;
  966.     HREFTYPE    hreftype;
  967.  
  968.  
  969.     if ((hresult = lpCreateTypeInfo->AddRefTypeInfo(lpTypeInfo, &hreftype)) == NOERROR)
  970.     {
  971.         hresult = lpCreateTypeInfo->AddImplType(0, hreftype);
  972.     }
  973.     lpTypeInfo->Release();
  974.     return hresult;
  975.  
  976.  
  977.  
  978.  
  979.     if ((riid == IID_IDispatch || riid == IID_IUnknown ) && GetSystemDirectory(szFile,sizeof(szFile)) > 0)
  980.     {
  981.          strcat(szFile, "\\stdole32.tlb");
  982.     }
  983.     else
  984.     {
  985.          ASSERT(0);
  986.          return 1;
  987.     }
  988.  
  989.     if ((hresult = OLEAnsiToOleString(szFile, &pOle)) == NOERROR)
  990.     {
  991.         if ((hresult = LoadTypeLib(pOle, &pITypeLib)) == NOERROR)
  992.         {
  993.             hresult = pITypeLib->GetTypeInfoOfGuid(riid, &lpIDispatchTypeInfo);
  994.             pITypeLib->Release();
  995.         }
  996.         OLEFreeString((void **)&pOle);
  997.  
  998.         if (hresult == NOERROR)
  999.         {
  1000.             if ((hresult = lpCreateTypeInfo->AddRefTypeInfo(lpIDispatchTypeInfo, &hreftype)) == NOERROR)
  1001.             {
  1002.                 hresult = lpCreateTypeInfo->AddImplType(0, hreftype);
  1003.             }
  1004.             lpIDispatchTypeInfo->Release();
  1005.         }
  1006.     }
  1007.  
  1008.     return hresult;
  1009.  
  1010. }
  1011.  
  1012.  
  1013. long CFoxtlibCtrl::TIWCreateTypeInfo(long lpCreateTypeLib, long TypeKind,long * res, LPCTSTR szArrName,LPCTSTR szTypeInfoName,long *lpTypeInfo) 
  1014. {
  1015.     LPCREATETYPEINFO lpCreateTypeInfo;
  1016.     int nResult = 1;
  1017.     Locator loc;
  1018.     Value val;
  1019.     HRESULT hr;
  1020.     OLECHAR *pOle;
  1021.     char szBuff[500];
  1022.     GUID myguid;
  1023.     __try {
  1024.         if (_FindVar(MyNameTableIndex((char *)szArrName),-1,&loc)) {
  1025.             if (_ALen(loc.l_NTI, AL_ELEMENTS) < 16)
  1026.             {
  1027.                 throw(631); //"Array argument not of proper size.");
  1028.             }
  1029.             OLEAnsiToOleString(szTypeInfoName,&pOle);
  1030.             hr = ((ICreateTypeLib *)lpCreateTypeLib)->CreateTypeInfo(pOle,(TYPEKIND)TypeKind, (ICreateTypeInfo **)&lpCreateTypeInfo);
  1031.             OLEFreeString((void **)&pOle);
  1032.             if (hr == TYPE_E_NAMECONFLICT) 
  1033.                 return hr;
  1034.             ASSERT(lpCreateTypeInfo);
  1035.             *res = (long) lpCreateTypeInfo;
  1036.  
  1037.  
  1038. /*
  1039. The second parameter returns a pointer to the handle of the added type information. 
  1040. If AddRefTypeInfo has been called previously for the same type information, the index 
  1041. that was returned by the previous call is returned in lphreftype. If the referenced type 
  1042. description is in the type library being created, its type information can be obtained by
  1043.  calling IUnknown::QueryInterface(IID_ITypeInfo, ...) on the ICreateTypeInfo interface of that type description.
  1044. */
  1045.             if (TKIND_DISPATCH == TypeKind) {
  1046.                 LPDISPATCH lDisp;
  1047.                 ((ICreateTypeInfo *)lpCreateTypeInfo)->QueryInterface(IID_ITypeInfo,(void **)&lDisp);
  1048.                 *lpTypeInfo = (long)lDisp;
  1049.             }
  1050.  
  1051.  
  1052.             //17 = Guid
  1053.             loc.l_sub1 = 17;
  1054.             _Load(&loc,&val);
  1055.             ASSERT(val.ev_type == 'C');
  1056.             _HLock(val.ev_handle);
  1057.             _MemMove(szBuff,(char *)_HandToPtr(val.ev_handle),val.ev_length);
  1058.             szBuff[val.ev_length] = '\0';
  1059.             _HUnLock(val.ev_handle);
  1060.             _FreeHand(val.ev_handle);
  1061.             OLEAnsiToOleString(szBuff,&pOle);
  1062.             CLSIDFromString(pOle,&myguid);
  1063.             OLEFreeString((void **)&pOle);
  1064.             ((ICreateTypeInfo *)lpCreateTypeInfo)->SetGuid(myguid);
  1065.  
  1066.             //13 cbAlignment
  1067.             loc.l_sub1 = 13;
  1068.             _Load(&loc,&val);
  1069.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1070.             ((ICreateTypeInfo *)lpCreateTypeInfo)->SetAlignment((unsigned short)VALUE_N_I(val));
  1071.  
  1072.             //14 wTypeFlags
  1073.             loc.l_sub1 = 14;
  1074.             _Load(&loc,&val);
  1075.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1076.             ((ICreateTypeInfo *)lpCreateTypeInfo)->SetTypeFlags(VALUE_N_I(val));
  1077.             if (TypeKind == TKIND_COCLASS) {
  1078. //            if (VALUE_N_I(val) & TYPEFLAG_FCANCREATE) {
  1079.                 AddImplType((ICreateTypeInfo *)lpCreateTypeInfo,IID_IDispatch,(LPTYPEINFO)*lpTypeInfo);
  1080.             }
  1081.  
  1082.  
  1083.  
  1084.  
  1085.             //15 wMajorVerNum
  1086.             loc.l_sub1 = 15;
  1087.             _Load(&loc,&val);
  1088.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1089.             int wMajorVerNum =(int)VALUE_N_I(val);
  1090.  
  1091.             //16 wMinorVerNum
  1092.             loc.l_sub1 = 16;
  1093.             _Load(&loc,&val);
  1094.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1095.             ((ICreateTypeInfo *)lpCreateTypeInfo)->SetVersion(wMajorVerNum,(unsigned short)VALUE_N_I(val));
  1096.  
  1097.  
  1098. /*
  1099.             //2 = LCID
  1100.             loc.l_sub1 = 2;
  1101.             ((ICreateTypeInfo *)lpTypeInfo)->SetGuid(myguid);
  1102.             val.ev_long = lpTypeAttr->lcid;
  1103.  
  1104.             //3 dwReserved
  1105.             loc.l_sub1 = 3;
  1106.             val.ev_type = 'I';
  1107.             val.ev_long = lpTypeAttr->dwReserved;
  1108.             _Store(&loc,&val);
  1109.  
  1110.             //4 Constructor
  1111.             loc.l_sub1 = 4;
  1112.             val.ev_type = 'I';
  1113.             val.ev_long = lpTypeAttr->memidConstructor;
  1114.             _Store(&loc,&val);
  1115.  
  1116.             //5 Destructor
  1117.             loc.l_sub1 = 5;
  1118.             val.ev_type = 'I';
  1119.             val.ev_long = lpTypeAttr->memidDestructor;
  1120.             _Store(&loc,&val);
  1121.  
  1122.             //6 lpstrSchema reserved
  1123.             loc.l_sub1 = 6;
  1124.             val.ev_type = 'I';
  1125.             val.ev_long = (int)lpTypeAttr->lpstrSchema;
  1126.             _Store(&loc,&val);
  1127.  
  1128.             //7 size Instance
  1129.             loc.l_sub1 = 7;
  1130.             val.ev_type = 'I';
  1131.             val.ev_long = lpTypeAttr->cbSizeInstance;
  1132.             _Store(&loc,&val);
  1133.  
  1134.             //8 TypeKind
  1135.             loc.l_sub1 = 8;
  1136.             val.ev_type = 'I';
  1137.             val.ev_long = lpTypeAttr->typekind;
  1138.             _Store(&loc,&val);
  1139.  
  1140.             //9 cFuncs
  1141.             loc.l_sub1 = 9;
  1142.             val.ev_type = 'I';
  1143.             val.ev_long = lpTypeAttr->cFuncs;
  1144.             _Store(&loc,&val);
  1145.  
  1146.             //10 cVars
  1147.             loc.l_sub1 = 10;
  1148.             val.ev_type = 'I';
  1149.             val.ev_long = lpTypeAttr->cVars;
  1150.             _Store(&loc,&val);
  1151.  
  1152.             //11 cImplTypes
  1153.             loc.l_sub1 = 11;
  1154.             val.ev_type = 'I';
  1155.             val.ev_long = lpTypeAttr->cImplTypes;
  1156.             _Store(&loc,&val);
  1157.  
  1158.             //12 cbSizeVft
  1159.             loc.l_sub1 = 12;
  1160.             val.ev_type = 'I';
  1161.             val.ev_long = lpTypeAttr->cbSizeVft;
  1162.             _Store(&loc,&val);
  1163.  
  1164. */
  1165.         }
  1166.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  1167.         nResult = 0;
  1168.     }
  1169.     return nResult;
  1170. }
  1171.  
  1172.  
  1173. //This func has 2 modes:
  1174. //If name is not empty, then pInterface is LPCREATETYPELIB
  1175. // else   pInterface is LPCREATETYPEINFO
  1176. long CFoxtlibCtrl::TLIWWriteDocumentation(long pInterface, LPCTSTR Name, LPCTSTR DocString, long HelpContext, LPCTSTR HelpFile, long nIndex) 
  1177. {
  1178.     HRESULT hr = E_FAIL;
  1179.     OLECHAR *pOle;
  1180.     __try {
  1181.         if (*Name) {
  1182.             if (*Name == '@') {
  1183.                 OLEAnsiToOleString(DocString,&pOle);
  1184.                 ((LPCREATETYPEINFO)pInterface)->SetFuncDocString(nIndex,pOle);
  1185.                 OLEFreeString((void **)&pOle);
  1186.  
  1187.                 ((LPCREATETYPEINFO)pInterface)->SetFuncHelpContext(nIndex,HelpContext);
  1188.  
  1189.             } else {
  1190.                 OLEAnsiToOleString(Name,&pOle);
  1191.                 ((LPCREATETYPELIB)pInterface)->SetName(pOle);
  1192.                 OLEFreeString((void **)&pOle);
  1193.  
  1194.                 OLEAnsiToOleString(DocString,&pOle);
  1195.                 ((LPCREATETYPELIB)pInterface)->SetDocString(pOle);
  1196.                 OLEFreeString((void **)&pOle);
  1197.  
  1198.                 ((LPCREATETYPELIB)pInterface)->SetHelpContext(HelpContext);
  1199.  
  1200.             }
  1201.         } else {
  1202.             OLEAnsiToOleString(DocString,&pOle);
  1203.             ((LPCREATETYPEINFO)pInterface)->SetDocString(pOle);
  1204.             OLEFreeString((void **)&pOle);
  1205.         }
  1206.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  1207.         hr = E_FAIL;
  1208.     }
  1209.     return hr;
  1210.     
  1211.  
  1212. }
  1213.  
  1214. long CFoxtlibCtrl::TILayout(long lpCreateTypeInfo)    // must be called to finish up writing a typeinfo
  1215. {
  1216.     HRESULT hr;
  1217.     __try {
  1218.         hr = ((LPCREATETYPEINFO)lpCreateTypeInfo)->LayOut();
  1219.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  1220.         hr = E_FAIL;
  1221.     }
  1222.     return hr;
  1223. }
  1224.  
  1225. long CFoxtlibCtrl::TIRelease(long lpTypeInfo) 
  1226. {
  1227.     HRESULT hr;
  1228.     __try {
  1229.         hr = ((LPTYPEINFO)lpTypeInfo)->Release();
  1230.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  1231.         hr = E_FAIL;
  1232.     }
  1233.     return hr;
  1234. }
  1235.  
  1236. long CFoxtlibCtrl::TIAddFuncDesc(long lpCreateTypeInfo, long nIndex, LPCTSTR szArrName, LPCTSTR szParmsArr, LPCTSTR szNamesArr,long nNames) 
  1237. {
  1238.     HRESULT hr;
  1239.     int i;
  1240.     FUNCDESC FuncDesc;
  1241.     ELEMDESC    edesc[1];
  1242.     Locator loc,locNames,locParms;
  1243.     Value val;
  1244.     int nParams;
  1245.     char szBuff[255];
  1246.     OLECHAR * pOleArr[MAXPARMS];
  1247.     __try {
  1248.         if (_FindVar(MyNameTableIndex((char *)szArrName),-1,&loc)) {
  1249.             if (_ALen(loc.l_NTI, AL_ELEMENTS) < 16)
  1250.             {
  1251.                 throw(631); //"Array argument not of proper size.");
  1252.             }
  1253.             memset(&FuncDesc,0,sizeof(FuncDesc));
  1254.  
  1255.             //1 = Memid
  1256.             loc.l_sub1 = 1;
  1257.             _Load(&loc,&val);
  1258.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1259.             FuncDesc.memid = (int)VALUE_N_I(val);
  1260.  
  1261.             //2 = FUNCKIND
  1262.             loc.l_sub1 = 2;
  1263.             _Load(&loc,&val);
  1264.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1265.             FuncDesc.funckind = (FUNCKIND)VALUE_N_I(val);
  1266.  
  1267.             //3 = INVOKEKIND
  1268.             loc.l_sub1 = 3;
  1269.             _Load(&loc,&val);
  1270.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1271.             FuncDesc.invkind = (INVOKEKIND)VALUE_N_I(val);
  1272.  
  1273.  
  1274.             //4 = CALLCONV
  1275.             loc.l_sub1 = 4;
  1276.             _Load(&loc,&val);
  1277.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1278.             FuncDesc.callconv = (CALLCONV)VALUE_N_I(val);
  1279.  
  1280.             //5 = cParams
  1281.             loc.l_sub1 = 5;
  1282.             _Load(&loc,&val);
  1283.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1284.             FuncDesc.cParams = (short) VALUE_N_I(val);
  1285.  
  1286.             //6 = cParamsOpt
  1287.             loc.l_sub1 = 6;
  1288.             _Load(&loc,&val);
  1289.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1290.             FuncDesc.cParamsOpt = (short)VALUE_N_I(val);
  1291.             nParams = FuncDesc.cParams + FuncDesc.cParamsOpt;
  1292.  
  1293.             //8 = cScodes
  1294.             loc.l_sub1 = 8;
  1295.             _Load(&loc,&val);
  1296.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1297.             FuncDesc.cScodes = (SHORT)VALUE_N_I(val);
  1298.  
  1299.             //9 = wFuncFlags
  1300.             loc.l_sub1 = 9;
  1301.             _Load(&loc,&val);
  1302.             FuncDesc.wFuncFlags = (WORD) VALUE_N_I(val);
  1303.  
  1304.             if (!_FindVar(MyNameTableIndex((char *)szParmsArr),-1,&locParms)) {
  1305.                 throw 631;
  1306.             }
  1307.  
  1308.             //get the type of the return value
  1309.             locParms.l_sub1 = 1;
  1310.             _Load(&locParms,&val);
  1311.             ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1312.             switch (FuncDesc.invkind)
  1313.             {
  1314.             case INVOKE_PROPERTYGET:
  1315.                 // return type
  1316.                 FuncDesc.elemdescFunc.tdesc.vt = (VARTYPE) VALUE_N_I(val);
  1317.                 break;
  1318.                 
  1319.             case INVOKE_FUNC:
  1320.             case INVOKE_PROPERTYPUT:
  1321.                 // 'Parameter info'
  1322.                 edesc[0].tdesc.vt = (VARTYPE) VALUE_N_I(val);
  1323.                 FuncDesc.lprgelemdescParam = (ELEMDESC *)edesc;
  1324.  
  1325.                 // return type
  1326.                 FuncDesc.elemdescFunc.tdesc.vt = VT_VOID;
  1327.                 break;
  1328.                 
  1329.  
  1330.             case INVOKE_PROPERTYPUTREF:
  1331.                 break;
  1332.             default:
  1333.                 ASSERT(0);
  1334.             }
  1335.             if (nParams) {
  1336.                 FuncDesc.lprgelemdescParam = (LPELEMDESC)_alloca((FuncDesc.cParams +1)* sizeof(ELEMDESC));
  1337.                 memset(FuncDesc.lprgelemdescParam,0,FuncDesc.cParams * sizeof(FuncDesc));
  1338.                 for (int i =0 ; i< nParams ; i++) {
  1339.                     locParms.l_sub1 = i + 2;
  1340.                     _Load(&locParms,&val);
  1341.                     ASSERT(val.ev_type == 'I' || val.ev_type == 'N');
  1342.                     FuncDesc.lprgelemdescParam[i].tdesc.vt = (VARTYPE)VALUE_N_I(val);
  1343.                 }
  1344.             }
  1345.             hr = ((LPCREATETYPEINFO)lpCreateTypeInfo)->AddFuncDesc(nIndex,&FuncDesc);
  1346.  
  1347.  
  1348.             if (!_FindVar(MyNameTableIndex((char *)szNamesArr),-1,&locNames)) {
  1349.                 throw(631);
  1350.             }
  1351.             if (_ALen(locNames.l_NTI, AL_ELEMENTS) < MAXPARMS)
  1352.             {
  1353.                 throw(631); //"Array argument not of proper size.");
  1354.             }
  1355.             for (i = 0 ; i < nNames ; i++) {
  1356.                 locNames.l_sub1 = i+1;
  1357.                 _Load(&locNames,&val);
  1358.                 ASSERT(val.ev_type == 'C');
  1359.                 _HLock(val.ev_handle);
  1360.                 _MemMove(szBuff,_HandToPtr(val.ev_handle),val.ev_length);
  1361.                 _HUnLock(val.ev_handle);
  1362.                 _FreeHand(val.ev_handle);
  1363.                 szBuff[val.ev_length] = '\0';
  1364.  
  1365.                 OLEAnsiToOleString(szBuff,&pOleArr[i]);
  1366.             }
  1367.  
  1368.  
  1369.  
  1370.             hr = ((LPCREATETYPEINFO)lpCreateTypeInfo)->SetFuncAndParamNames(nIndex,pOleArr,nNames);
  1371.  
  1372.             for (i = 0 ; i < nNames ; i++) {
  1373.                 OLEFreeString((void **)&pOleArr[i]);
  1374.             }
  1375.  
  1376.  
  1377.  
  1378. /*
  1379.  
  1380.             if (_FindVar(MyNameTableIndex((char *)szParmsArr),-1,&ploc)) {
  1381.                 int nelem = lpFuncDesc->cParams + lpFuncDesc->cParamsOpt;
  1382.                 if (_ALen(loc.l_NTI, AL_ELEMENTS) < nelem)
  1383.                 {
  1384.                     throw(631); //"Array argument not of proper size.");
  1385.                 }
  1386.                 ploc.l_sub1 = 1;
  1387.                 val.ev_type = 'I';
  1388.                 val.ev_long = (long) lpFuncDesc->elemdescFunc.tdesc.vt;
  1389.                 _Store(&ploc,&val);
  1390.                 for (int i = 0 ; i < nelem ; i++) {
  1391.                     ploc.l_sub1 = 2 + i;        //start parms at xbase array element #2
  1392.                     val.ev_type = 'I';
  1393.                     val.ev_long = (long)lpFuncDesc->lprgelemdescParam[i].tdesc.vt;
  1394.                     _Store(&ploc,&val);
  1395.  
  1396.                 }
  1397.  
  1398.  
  1399.             }
  1400.  
  1401.  
  1402.             //7 = oVft;
  1403.             loc.l_sub1 = 7;
  1404.             val.ev_type = 'I';
  1405.             val.ev_long = lpFuncDesc->oVft;
  1406.             _Store(&loc,&val);
  1407.  
  1408.             //8 = cScodes
  1409.             loc.l_sub1 = 8;
  1410.             val.ev_type = 'I';
  1411.             val.ev_long = lpFuncDesc->cScodes;
  1412.             _Store(&loc,&val);
  1413.  
  1414.  
  1415.             //9 = wFuncFlags
  1416.             loc.l_sub1 = 9;
  1417.             val.ev_type = 'I';
  1418.             val.ev_long = lpFuncDesc->wFuncFlags;
  1419.             _Store(&loc,&val);
  1420.  
  1421.  
  1422.             ((ITypeInfo *)pTypeInfo)->ReleaseFuncDesc(lpFuncDesc);
  1423. */
  1424.         
  1425.         }
  1426.     } __except  (EXCEPTION_EXECUTE_HANDLER) {
  1427.         hr = E_FAIL;
  1428.     }
  1429.     return hr;
  1430. }
  1431.